Tech Arsenal 1

home *** CD-ROM | disk | FTP | other *** search

/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / prodpack.zip / DB4PPSAM.EXE / OPENFILE.PRG < prev next >

Wrap

Text File | 1993-05-25 | 74KB | 2,529 lines

*-- DBW - Dialog Box Workshop - OPENFILE.PRG PROCEDURE OPENFILE *---------------------------------------------------------------------------- * NAME * DESCRIPTION *---------------------------------------------------------------------------- PRIVATE cAlias, cWindow, lTalk, lSafety, cDialog, cHelpFile, cStartLib IF SET( "TALK" ) = "ON" SET TALK OFF lTalk = .T. ELSE lTalk = .F. ENDIF lSafety = SET( "SAFETY" ) = "ON" SET SAFETY OFF cWindow = WINDOW() cAlias = ALIAS() *---------------------------------- *-- Setup the help system variables *---------------------------------- lError = .F. cHelpFile = "DBBHELP" cDialog = "OPENFILE" cDBBLib = "DBBLIB" *---------------------------------------------- *-- Setup the link to the DBB Procedure Library *---------------------------------------------- ON ERROR lError = .T. cStartLib = SET( "PROCEDURE" ) SET PROCEDURE TO ( cDBBLib ) IF lError lError = .F. SET PROCEDURE TO HOME() + cDBBLib IF lError *-- Display the error message in a windowed box PRIVATE lc_anykey, lc_msg, lc_msglen, lc_win, ln_press, ln_width, ll_trap,; ll_escape lc_anykey = [Press any key to continue...] ln_press = LEN( lc_anykey ) lc_msg = [Could not locate procedure file: ] + cDBBLib ln_msglen = LEN( lc_msg ) ln_width = 0 ll_escape = SET("ESCAPE") = "ON" SET ESCAPE OFF *-- Determine the width needed for the window: IF ln_msglen <= ln_press ln_width = ln_press ELSE *-- Make sure the message fits in the window: IF ln_msglen > 76 lc_msg = LEFT( lc_msg, 76 ) ln_msglen = 76 ENDIF ln_width = ln_msglen ENDIF DEFINE WINDOW _err_box FROM 9, ((76 - ln_width) + .5) / 2 ; TO 15, (ln_width + 83) / 2 DOUBLE ln_width = ( ln_width + 2 ) *-- Display the message and prompt to the window and wait for a key press ACTIVATE WINDOW _err_box ? lc_msg AT ( ln_width - ln_msglen ) / 2 ? ? lc_anykey AT ( ln_width - ln_press ) / 2 SET CONSOLE OFF WAIT SET CONSOLE ON *-- Clean up the window display and reactivate the previous window RELEASE WINDOW _err_box IF ll_escape SET ESCAPE ON ELSE SET ESCAPE OFF ENDIF ENDIF ENDIF ON ERROR *--------------------------------- *-- Run the actual dialog box code *--------------------------------- IF .NOT. lError DO Dialog ENDIF *---------------------------------- *-- Restore the startup environment *---------------------------------- IF .NOT. ISBLANK( cStartLib ) SET PROCEDURE TO ( cStartLib ) ENDIF IF .NOT. ISBLANK( cAlias ) .AND. SELECT( cAlias ) > 0 SELECT ( cAlias ) ENDIF IF lSafety SET SAFETY ON ENDIF IF lTalk SET TALK ON ENDIF IF .NOT. ISBLANK( cWindow ) ACTIVATE WINDOW &cWindow ENDIF RETURN *-- EOP: OPENFILE PROCEDURE Dialog *---------------------------------------------------------------------------- * NAME * Dialog - * * DESCRIPTION * *---------------------------------------------------------------------------- *--------------------------------------- *-- Temporary for now, message varaibles *--------------------------------------- DLN_OK = -500 DLN_CANCEL = -501 DLN_HELP = -502 WM_PAINT = 15 && Notification to repaint client area WM_CLOSE = 16 && Note that user selected close button WM_DRAWITEM = 43 && Notification to the owner of an BN_CLICKED = 0 BN_PAINT = 1 BN_HILITE = 2 BN_UNHILITE = 3 BN_DISABLE = 4 BN_DEFAULT = 6 BN_PRESSED = 7 BN_COLOR = 8 SE_SHADOW = -100 EN_SETFOCU = 1 EN_KILLFOC = 2 CB_SELECTS = 13 CB_SHOWDRO = 15 CB_HIDELST = 25 CBN_SELCHAN = 1 CBN_DBLCLK = 2 CBN_SETFOCU = 3 CBN_KILLFOC = 4 CBN_EDITCHA = 5 CBN_EDITUPD = 6 CBN_DROPDOW = 7 CBN_INLIST = 8 LBN_SELCHA = 1 LBN_DBLCLK = 2 LBN_SELCAN = 3 LBN_SETFOC = 4 LBN_KILLFO = 5 KB_TAB = 9 KB_ENTER = 13 KB_SPACE = 32 KB_SHIFTTAB = -400 KB_UPARROW = 5 KB_DOWNARROW = 24 KB_LEFTARROW = 19 KB_RTARROW = 4 KB_F1 = 28 KB_ESC = 27 KB_MOUSE = -100 KB_CTRLW = 23 *-------------------- *-- Working variables *-------------------- PRIVATE nCurrent, nCurrGrp, lButtAct, nMRow, nMCol, nMsEvent, nDlgDef, nAccel PRIVATE n1stGrp, nCancelBt nCurrent = 0 && Current dialog object id nCurrGrp = 0 && Current group id for object id lButtAct = .F. && Dialog has a button active nMRow = -1 nMCol = -1 nMsEvent = 0 nDlgDef = 0 nAccel = 0 n1stGrp = 0 nCancelBt = 0 && Id for cancel button PRIVATE nDefButt, nMess nDefButt = 0 && Number of object with default button nMess = 0 PRIVATE cOldFClr, cOldBClr, cOldHClr, cOldMClr, cOldNClr, cOldTClr cOldFClr = _ColorChk( "F" ) cOldBClr = _ColorChk( "B" ) cOldHClr = _ColorChk( "H" ) cOldMClr = _ColorChk( "M" ) cOldNClr = _ColorChk( "N" ) cOldTClr = _ColorChk( "T" ) SET COLOR OF FIELDS TO w+/b SET COLOR OF BOX TO n/gb SET COLOR OF HIGH TO w+/g SET COLOR OF MESS TO n/gb SET COLOR OF TITLE TO n/gb *------------------------ *-- Close Icon for window *------------------------ PRIVATE nRowCls, nOrigRow, nOrigCol, nXoffset, nYOffset, nCol, ; nHigh, nWidth, nLColCls, nRColCls, nRWinCol, cField, cClass, nScreen cField = "" cClass = "" nRowCls = 2 nOrigRow = 2 nOrigCol = 13 nXOffset = 0 nYOffset = 0 nCol = 13 nHigh = 18 nWidth = 60 nLColCls = 15 nRColCls = 17 nRWinCol = 72 nScreen = IIF( "50" $ SET("DISPLAY"), 49, ; IIF( "43" $ SET("DISPLAY"), 42, 24 ) ) IF SET( "STATUS" ) = "ON" nScreen = nScreen - 3 ENDIF PRIVATE nClkBox, nClkObj, aClkBox, aClkObj, aObjPoint *-------------------------------------------------- *-- Get the number of clickable boxes in the dialog *-------------------------------------------------- nClkBox = 1 DECLARE aClkBox[ 1 , 6 ] aClkBox[ 1 , 1 ] = 6 && CS_FILE_1 aClkBox[ 1 , 2 ] = 11 aClkBox[ 1 , 3 ] = 16 aClkBox[ 1 , 4 ] = 14 aClkBox[ 1 , 5 ] = 6 aClkBox[ 1 , 6 ] = .F. && Clink in the box flag *-------------------------------------------------- *-- Get the number of clickable items in the dialog *-------------------------------------------------- nClkObj = 6 DECLARE aClkObj[ 6 , 13 ] aClkObj[ 1 , 1 ] = 5 && Row aClkObj[ 1 , 2 ] = 15 && Col aClkObj[ 1 , 3 ] = 29 && Decimals aClkObj[ 1 , 4 ] = 5 && CurrentId aClkObj[ 1 , 5 ] = 3 && GroupId aClkObj[ 1 , 6 ] = 7 && NextId aClkObj[ 1 , 7 ] = 21 && PrevId aClkObj[ 1 , 8 ] = " " && PickKey aClkObj[ 1 , 9 ] = 5 && Previous item in group aClkObj[ 1 ,10 ] = 5 && Next item in group aClkObj[ 1 ,11 ] = "CS_FILE_1" && XXXXXXXXXXXXXXX aClkObj[ 1 ,12 ] = [] aClkObj[ 1 ,13 ] = [] aClkObj[ 2 , 1 ] = 5 && Row aClkObj[ 2 , 2 ] = 33 && Col aClkObj[ 2 , 3 ] = 65 && Decimals aClkObj[ 2 , 4 ] = 7 && CurrentId aClkObj[ 2 , 5 ] = 4 && GroupId aClkObj[ 2 , 6 ] = 15 && NextId aClkObj[ 2 , 7 ] = 5 && PrevId aClkObj[ 2 , 8 ] = " " && PickKey aClkObj[ 2 , 9 ] = 7 && Previous item in group aClkObj[ 2 ,10 ] = 7 && Next item in group aClkObj[ 2 ,11 ] = "CL_TYPE_1" && XXXXXXXXXXXXXXXXXXXXXXXXXXXXX [v] aClkObj[ 2 ,12 ] = [] aClkObj[ 2 ,13 ] = [] aClkObj[ 3 , 1 ] = 14 && Row aClkObj[ 3 , 2 ] = 40 && Col aClkObj[ 3 , 3 ] = 52 && Decimals aClkObj[ 3 , 4 ] = 15 && CurrentId aClkObj[ 3 , 5 ] = 12 && GroupId aClkObj[ 3 , 6 ] = 19 && NextId aClkObj[ 3 , 7 ] = 7 && PrevId aClkObj[ 3 , 8 ] = "R" && PickKey aClkObj[ 3 , 9 ] = 15 && Previous item in group aClkObj[ 3 ,10 ] = 15 && Next item in group aClkObj[ 3 ,11 ] = "CK_READ_1" && [ ] ~Read-only aClkObj[ 3 ,12 ] = [] aClkObj[ 3 ,13 ] = [] aClkObj[ 4 , 1 ] = 17 && Row aClkObj[ 4 , 2 ] = 32 && Col aClkObj[ 4 , 3 ] = 44 && Decimals aClkObj[ 4 , 4 ] = 19 && CurrentId aClkObj[ 4 , 5 ] = 19 && GroupId aClkObj[ 4 , 6 ] = 20 && NextId aClkObj[ 4 , 7 ] = 15 && PrevId aClkObj[ 4 , 8 ] = "D" && PickKey aClkObj[ 4 , 9 ] = 19 && Previous item in group aClkObj[ 4 ,10 ] = 19 && Next item in group aClkObj[ 4 ,11 ] = "BT_DEMO" && ~Demo dialog aClkObj[ 4 ,12 ] = [] aClkObj[ 4 ,13 ] = [] aClkObj[ 5 , 1 ] = 17 && Row aClkObj[ 5 , 2 ] = 49 && Col aClkObj[ 5 , 3 ] = 56 && Decimals aClkObj[ 5 , 4 ] = 20 && CurrentId aClkObj[ 5 , 5 ] = 20 && GroupId aClkObj[ 5 , 6 ] = 21 && NextId aClkObj[ 5 , 7 ] = 19 && PrevId aClkObj[ 5 , 8 ] = " " && PickKey aClkObj[ 5 , 9 ] = 20 && Previous item in group aClkObj[ 5 ,10 ] = 20 && Next item in group aClkObj[ 5 ,11 ] = "BT_OK" && Ok aClkObj[ 5 ,12 ] = [] aClkObj[ 5 ,13 ] = [The file name must not be blank] aClkObj[ 6 , 1 ] = 17 && Row aClkObj[ 6 , 2 ] = 62 && Col aClkObj[ 6 , 3 ] = 69 && Decimals aClkObj[ 6 , 4 ] = 21 && CurrentId aClkObj[ 6 , 5 ] = 21 && GroupId aClkObj[ 6 , 6 ] = 5 && NextId aClkObj[ 6 , 7 ] = 20 && PrevId aClkObj[ 6 , 8 ] = " " && PickKey aClkObj[ 6 , 9 ] = 21 && Previous item in group aClkObj[ 6 ,10 ] = 21 && Next item in group aClkObj[ 6 ,11 ] = "BT_CANCEL" && Cancel aClkObj[ 6 ,12 ] = [] aClkObj[ 6 ,13 ] = [] nCancelBt = 21 *------------------------------------------------------------- *-- Setup object pointers in to the current object array above *------------------------------------------------------------- DECLARE aObjPoint[ 21 ] aObjPoint[ 5 ] = 1 aObjPoint[ 7 ] = 2 aObjPoint[ 15 ] = 3 aObjPoint[ 19 ] = 4 aObjPoint[ 20 ] = 5 aObjPoint[ 21 ] = 6 *------------------------------------------------------------------- *-- Setup private memory variables for object states (from InitObjs) *-- First variable with the object memvar name contains the value *-- for the object. The second varaible, if present, indicates *-- the id of the object previously active in the group. *------------------------------------------------------------------- PRIVATE cs_file_1 cs_file_1 = "" PRIVATE nCs_file nCs_file = 0 PRIVATE cl_type_1 cl_type_1 = "" PRIVATE nCl_type nCl_type = 0 PRIVATE ck_read_1 ck_read_1 = "" PRIVATE nCk_read nCk_read = 15 PRIVATE bt_demo bt_demo = "" PRIVATE bt_ok bt_ok = "" PRIVATE bt_cancel bt_cancel = "" DO InitObjs DO DrawDial && Draw all the dialog objects *-------------------------------- *-- Set focus to the first object *-------------------------------- DO GetNext WITH nCurrent, .T. *-- The message loop nMess = 0 DO WHILE .NOT. GetMess() DO Dispatch IF nMess = DLN_OK .OR. nMess = DLN_CANCEL EXIT ENDIF ENDDO IF nMess = DLN_OK DO PostVals FXL_Cancel = .F. ELSE FXL_Cancel = .T. ENDIF RELEASE WINDOW OPENFILE RESTORE SCREEN FROM OPENFILE RELEASE SCREEN OPENFILE DO ReleObjs SET COLOR OF FIELDS TO &cOldFClr SET COLOR OF BOX TO &cOldBClr SET COLOR OF HIGH TO &cOldHClr SET COLOR OF MESS TO &cOldMClr SET COLOR OF TITLE TO &cOldTClr SET CURSOR ON RETURN *-- EOP: Dialog PROCEDURE InitObjs *---------------------------------------------------------------------------- * NAME * InitObjs - Scan the design DBF file and initialize the object variables * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE cField, cClass, cDefault, Value, lInitDef *-------------------------------------------------- *-- Determine if an initialization array is present *-------------------------------------------------- lInitDef = TYPE( "OPENFILE[1]" ) <> "U" *------------------------------- *-- Set the default button value *------------------------------- nDlgDef = 20 *----------------------------------------------------------------- *-- If the Initialize array is present, then set the object values *-- based on the array. *----------------------------------------------------------------- IF lInitDef CS_FILE_1 = OPENFILE[ 1 ] CL_TYPE_1 = OPENFILE[ 2 ] CK_READ_1 = OPENFILE[ 3 ] BT_DEMO = OPENFILE[ 4 ] BT_OK = OPENFILE[ 5 ] BT_CANCEL = OPENFILE[ 6 ] ELSE *-------------------------------------------------------- *-- Otherwise, use the values stored in the resource file *-------------------------------------------------------- CS_FILE_1 = "*.SCR " CL_TYPE_1 = "SCREEN FILES (*.SCR) " CK_READ_1 = .F. BT_DEMO = .F. BT_OK = .T. BT_CANCEL = .F. ENDIF nCurrent = 5 && Current dialog object id nCurrGrp = 3 && Current group id for object id n1stGrp = 3 RETURN *-- EOP: InitObjs PROCEDURE DrawDial *---------------------------------------------------------------------------- * NAME * DrawDial - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE lInitDef lInitDef = TYPE( "OPENFILE[1]" ) <> "U" IF FILE( "OPENFILE.WIN" ) .AND. ( .NOT. lInitDef .OR. ; ( TYPE( "FXL_NoChng" ) = "L" .AND. FXL_NoChng ) ) *-------------------- *-- Dialog box shadow *-------------------- SAVE SCREEN TO OPENFILE ACTIVATE SCREEN @ 3, 14 FILL TO 20, 73 RESTORE WINDOW OPENFILE FROM OPENFILE ACTIVATE WINDOW OPENFILE DO TCombo WITH WM_PAINT, CB_SHOWDRO, 5 DO TCombo WITH WM_PAINT, CB_HIDELST, 7 ELSE *------------------------- *-- Draw the dialog window *------------------------- *-------------------- *-- Dialog box shadow *-------------------- SAVE SCREEN TO OPENFILE ACTIVATE SCREEN @ 3, 14 FILL TO 20, 73 DEFINE WINDOW OPENFILE FROM 2,13 TO 19,72 NONE COLOR n/w ACTIVATE WINDOW OPENFILE @ 0, 0 TO 17 , 59 DOUBLE COLOR w+/w *------------------------ *-- Close Icon for window *------------------------ @ 0, 2 SAY "[ ]" COLOR w+/w @ 0, 3 SAY CHR( 254 ) COLOR g+/w *--------------------------------- *-- Draw the other control objects *--------------------------------- @ 0,22 SAY " Open file" COLOR w+/w @ 10,25 SAY "┌──────────────────" COLOR n/w @ 10,44 SAY "┐" COLOR w+/w @ 11,25 SAY "│" COLOR n/w @ 11,44 SAY "│" COLOR w+/w @ 12,25 SAY "│" COLOR n/w @ 12,44 SAY "│" COLOR w+/w @ 13,25 SAY "└" COLOR n/w @ 13,26 SAY "──────────────────┘" COLOR w+/w DO TStatic WITH WM_PAINT, BN_PAINT, 3 DO TEdit WITH WM_PAINT, EN_KILLFOC, 5 DO TCombo WITH WM_PAINT, CB_SHOWDRO, 5 DO TStatic WITH WM_PAINT, BN_PAINT, 4 DO TCombo WITH WM_PAINT, CB_HIDELST, 7 DO TStatic WITH WM_PAINT, BN_PAINT, 12 DO TButton WITH WM_PAINT, BN_PAINT, 15 DO TButton WITH WM_PAINT, BN_PAINT, 19 DO TButton WITH WM_PAINT, SE_SHADOW, 19 DO TButton WITH WM_PAINT, BN_PAINT, 20 DO TButton WITH WM_PAINT, SE_SHADOW, 20 DO TButton WITH WM_PAINT, BN_PAINT, 21 DO TButton WITH WM_PAINT, SE_SHADOW, 21 IF .NOT. lInitDef SAVE WINDOW OPENFILE TO OPENFILE ENDIF ENDIF RETURN *-- EOP: DrawDial PROCEDURE TStatic PARAMETERS pn_msg, pc_data, pnObject *---------------------------------------------------------------------------- * NAME * TStatic - * * DESCRIPTION * * PARAMETERS * pn_msg = * pc_data = * pnObject = * *---------------------------------------------------------------------------- DO CASE CASE pnObject = 3 DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 2, 2 SAY "File name:" COLOR n/w CASE pc_data = BN_HILITE @ 2, 2 SAY "File name:" COLOR w+/w CASE pc_data = BN_DISABLE @ 2, 2 SAY "File name:" COLOR n+/w CASE pc_data = BN_COLOR @ 2, 2 SAY "File name:" COLOR w+/n ENDCASE IF pc_data <> BN_DISABLE @ 2, 7 SAY "n" COLOR gr+/w ENDIF CASE pnObject = 4 DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 2, 20 SAY "List Files of Type:" COLOR n/w CASE pc_data = BN_HILITE @ 2, 20 SAY "List Files of Type:" COLOR w+/w CASE pc_data = BN_DISABLE @ 2, 20 SAY "List Files of Type:" COLOR n+/w CASE pc_data = BN_COLOR @ 2, 20 SAY "List Files of Type:" COLOR w+/n ENDCASE IF pc_data <> BN_DISABLE @ 2, 34 SAY "T" COLOR gr+/w ENDIF CASE pnObject = 12 DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 11, 27 SAY "Open file mode:" COLOR n/w CASE pc_data = BN_HILITE @ 11, 27 SAY "Open file mode:" COLOR w+/w CASE pc_data = BN_DISABLE @ 11, 27 SAY "Open file mode:" COLOR n+/w CASE pc_data = BN_COLOR @ 11, 27 SAY "Open file mode:" COLOR n/w ENDCASE ENDCASE RETURN *-- EOP: TStatic WITH pn_msg, pc_data, pnObject PROCEDURE HasTitle PARAMETERS pnObject, pnWay *---------------------------------------------------------------------------- * NAME * HasTitle - Display the label for the group of objects * * DESCRIPTION * * PARAMETERS * pnObject = nCurrent value for group item * pnWay = BN_HILITE, BN_UNHILITE, or BN_DISABLE * *---------------------------------------------------------------------------- DO CASE CASE pnObject = 5 DO TStatic WITH WM_PAINT, pnWay, 3 CASE pnObject = 7 DO TStatic WITH WM_PAINT, pnWay, 4 CASE pnObject = 15 DO TStatic WITH WM_PAINT, pnWay, 12 ENDCASE *-- EOP: HasTitle WITH pnObject, pnWay FUNCTION GetMess *---------------------------------------------------------------------------- * NAME * GetMess() - * DEPENDENCIES * Uses nCurrent to determine the wait state for the given object. *---------------------------------------------------------------------------- PRIVATE lRtn DO CASE CASE nCurrent = 5 && CS_FILE_1 ON KEY LABEL F1 DO DlgHlpHd DO GetEdit ON KEY LABEL F1 CASE nCurrent = 7 && CL_TYPE_1 DO GetDDL CASE nCurrent = 15 && CK_READ_1 DO GetWait CASE nCurrent = 19 && BT_DEMO DO TButton WITH WM_PAINT, BN_UNHILITE, 20 BT_DEMO = .F. DO GetWait CASE nCurrent = 20 && BT_OK DO GetWait CASE nCurrent = 21 && BT_CANCEL DO TButton WITH WM_PAINT, BN_UNHILITE, 20 BT_CANCEL = .F. DO GetWait ENDCASE IF nMess = KB_F1 DO _HelpSys WITH cDialog, ; LEFT( TRANSFORM( aObjPoint[ nCurrent ], "@L 99" ) + ; aClkObj[ aObjPoint[ nCurrent ], 11 ], 10 ), ; cHelpFile ENDIF IF nMess = KB_ESC lRtn = .T. ELSE lRtn = .F. ENDIF RETURN lRtn *-- EOF: GetMess( ) PROCEDURE DlgHlpHd *---------------------------------------------------------------------------- * NAME * DlgHlpHd - * * DESCRIPTION * *---------------------------------------------------------------------------- DO _HelpSys WITH cDialog, ; LEFT( TRANSFORM( aObjPoint[ nCurrent ], "@L 99" ) + ; aClkObj[ aObjPoint[ nCurrent ], 11 ], 10 ), ; cHelpFile nMess = 0 RETURN *-- EOP: DlgHlpHd PROCEDURE GetWait *---------------------------------------------------------------------------- * NAME * GetWait - * * DESCRIPTION * *---------------------------------------------------------------------------- nMess = 0 nAccel = 0 lButtAct = .T. DO TButton WITH WM_PAINT, BN_HILITE, nCurrent SET CONSOLE OFF SET CURSOR OFF WAIT SET CONSOLE ON nMess = LASTKEY() nMRow = MROW() nMCol = MCOL() RETURN *-- EOP: GetWait PROCEDURE TButton PARAMETERS pn_msg, pc_data, pnObject *---------------------------------------------------------------------------- * NAME * TButton - * * DESCRIPTION * * PARAMETERS * pn_msg = * pc_data = * pnObject = * *---------------------------------------------------------------------------- DO CASE CASE pnObject = 15 && CK_READ_1 DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT .OR. pc_data = BN_UNHILITE @ 12, 27 SAY "[ ] Read-only " COLOR n/gb @ 12, 28 SAY IIF( CK_READ_1 , "X"," " ) COLOR n/gb CASE pc_data = BN_HILITE @ 12, 27 SAY "[ ] Read-only " COLOR w+/gb @ 12, 28 SAY IIF( CK_READ_1 , "X"," " ) COLOR w+/gb CASE pc_data = BN_DISABLE @ 12, 27 SAY "[ ] Read-only " COLOR n+/gb @ 12, 28 SAY IIF( CK_READ_1 , "X"," " ) COLOR n+/gb ENDCASE IF pc_data <> BN_DISABLE @ 12, 31 SAY "R" COLOR gr+/gb ENDIF CASE pn_msg = BN_CLICKED IF CK_READ_1 STORE .F. TO CK_READ_1 ELSE STORE .T. TO CK_READ_1 ENDIF DO TButton WITH WM_PAINT, BN_HILITE, 15 ENDCASE CASE pnObject = 19 && BT_DEMO DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT @ 15, 19 SAY " Demo dialog " COLOR n/g CASE pc_data = BN_HILITE @ 15, 19 SAY " Demo dialog " COLOR w+/g CASE pc_data = BN_UNHILITE @ 15, 19 SAY " Demo dialog " COLOR n/g CASE pc_data = BN_DEFAULT @ 15, 19 SAY " Demo dialog " COLOR bg+/g CASE pc_data = BN_DISABLE @ 15, 19 SAY " Demo dialog " COLOR n+/g CASE pc_data = SE_SHADOW @ 16, 20 SAY "▀▀▀▀▀▀▀▀▀▀▀▀▀" COLOR n/w @ 15, 32 SAY "▄" COLOR n/w CASE pc_data = BN_PRESSED @ 16, 20 SAY SPACE( 13 ) COLOR n/w @ 15, 19 SAY " " COLOR n/w @ 15, 32 SAY " " COLOR n/w @ 15, 20 SAY " Demo dialog " COLOR w+/g ENDCASE IF pc_data <> BN_PRESSED .AND. pc_data <> BN_DISABLE @ 15, 20 SAY "D" COLOR gr+/g ENDIF CASE pn_msg = BN_CLICKED DO TButton WITH WM_PAINT, BN_PRESSED, 19 *--------------------------------------- *-- Do the program contained in DO() UDF *--------------------------------------- DO tvdial DO TButton WITH WM_PAINT, BN_PAINT, 19 DO TButton WITH WM_PAINT, SE_SHADOW, 19 ENDCASE CASE pnObject = 20 && BT_OK DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT @ 15, 36 SAY " Ok " COLOR bg+/g CASE pc_data = BN_HILITE @ 15, 36 SAY " Ok " COLOR w+/g CASE pc_data = BN_UNHILITE @ 15, 36 SAY " Ok " COLOR n/g CASE pc_data = BN_DEFAULT @ 15, 36 SAY " Ok " COLOR bg+/g CASE pc_data = BN_DISABLE @ 15, 36 SAY " Ok " COLOR n+/g CASE pc_data = SE_SHADOW @ 16, 37 SAY "▀▀▀▀▀▀▀▀" COLOR n/w @ 15, 44 SAY "▄" COLOR n/w CASE pc_data = BN_PRESSED @ 16, 37 SAY SPACE( 8 ) COLOR n/w @ 15, 36 SAY " " COLOR n/w @ 15, 44 SAY " " COLOR n/w @ 15, 37 SAY " Ok " COLOR w+/g ENDCASE CASE pn_msg = BN_CLICKED DO TButton WITH WM_PAINT, BN_PRESSED, 20 IF OpenFiVl( "BT_OK" ) nMess = DLN_OK ENDIF x = INKEY( .2 ) DO TButton WITH WM_PAINT, BN_PAINT, 20 DO TButton WITH WM_PAINT, SE_SHADOW, 20 ENDCASE CASE pnObject = 21 && BT_CANCEL DO CASE CASE pn_msg = WM_PAINT DO CASE CASE pc_data = BN_PAINT @ 15, 49 SAY " Cancel " COLOR n/g CASE pc_data = BN_HILITE @ 15, 49 SAY " Cancel " COLOR w+/g CASE pc_data = BN_UNHILITE @ 15, 49 SAY " Cancel " COLOR n/g CASE pc_data = BN_DEFAULT @ 15, 49 SAY " Cancel " COLOR bg+/g CASE pc_data = BN_DISABLE @ 15, 49 SAY " Cancel " COLOR n+/g CASE pc_data = SE_SHADOW @ 16, 50 SAY "▀▀▀▀▀▀▀▀" COLOR n/w @ 15, 57 SAY "▄" COLOR n/w CASE pc_data = BN_PRESSED @ 16, 50 SAY SPACE( 8 ) COLOR n/w @ 15, 49 SAY " " COLOR n/w @ 15, 57 SAY " " COLOR n/w @ 15, 50 SAY " Cancel " COLOR w+/g ENDCASE CASE pn_msg = BN_CLICKED DO TButton WITH WM_PAINT, BN_PRESSED, 21 x = INKEY( .2 ) nMess = DLN_CANCEL DO TButton WITH WM_PAINT, BN_PAINT, 21 DO TButton WITH WM_PAINT, SE_SHADOW, 21 ENDCASE ENDCASE RETURN *-- EOP: TButton WITH pn_msg, pc_data, pnObject PROCEDURE GetEdit *---------------------------------------------------------------------------- * NAME * GetEdit - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE lSkipRead lSkipRead = .F. nMess = 0 nAccel = 0 nMsEvent = 0 ON MOUSE DO MsHand WITH MROW(), MCOL() DO SetOnKey DO CASE CASE nCurrent = 5 @ 3, 2 GET CS_FILE_1 PICTURE '@S15' IF aClkBox[ 1 ,6 ] lSkipRead = .T. aClkBox[ 1 ,6 ] = .F. ENDIF ENDCASE IF .NOT. lSkipRead SET CURSOR ON READ SET CURSOR OFF ENDIF DO ClrOnKey ON MOUSE IF .NOT. lSkipRead IF nMsEvent = KB_MOUSE nMess = KB_MOUSE ELSE nMess = LASTKEY() ENDIF ELSE nMess = KB_DOWNARROW ENDIF RETURN *-- EOP: GetEdit PROCEDURE TEdit PARAMETERS pn_msg, p__data, pnObject *---------------------------------------------------------------------------- * NAME * TEdit - * * DESCRIPTION * * PARAMETERS * pn_msg = * p__data = * pnObject = * *---------------------------------------------------------------------------- DO CASE CASE pnObject = 5 && CS_FILE_1 DO CASE CASE p__data = EN_KILLFOC @ 3, 2 GET CS_FILE_1 PICTURE '@S80 XXXXXXXXXXXXXXX' CLEAR GETS ENDCASE ENDCASE RETURN *-- EOP: TEdit WITH pn_msg, p__data, pnObject PROCEDURE TList PARAMETERS pn_msg, p__data, pnObject *---------------------------------------------------------------------------- * NAME * TList - * * DESCRIPTION * * PARAMETERS * pn_msg = * p__data = * pnObject = * *---------------------------------------------------------------------------- IF TYPE( "cPopDef" ) <> "C" cPopDef = "" ENDIF DO CASE CASE pnObject = 5 DO CASE CASE pn_msg = WM_PAINT DO CASE CASE p__data = LBN_KILLFO DO HasTitle WITH nCurrent, BN_UNHILITE CASE p__data = WM_DRAWITEM SET COLOR OF MESS TO n/gb SET COLOR OF TITLE TO n/gb IF ISBLANK( CS_FILE_1 ) DEFINE POPUP Cs_file_1 FROM 4, 3 TO 14, 16 PROMPT FILES LIKE *.* ELSE DEFINE POPUP Cs_file_1 FROM 4, 3 TO 14, 16 PROMPT FILES LIKE &CS_FILE_1 ENDIF SHOW POPUP CS_FILE_1 ENDCASE CASE pn_msg = LBN_SETFOC SET COLOR OF MESS TO n/gb SET COLOR OF TITLE TO n/gb nMsEvent = 0 nMess = 0 nAccel = 0 && dBRIEF Tag... pl_IsPop = .T. ON MOUSE DO MsHand WITH MROW(), MCOL(), .T. DO SetOnKey ON KEY LABEL Tab DO TabOut WITH KB_TAB ON KEY LABEL BackTab DO TabOut WITH KB_SHIFTTAB lOk = .T. ON ERROR lOk = .F. ON POPUP CS_FILE_1 DO TList WITH LBN_SELCHA, .F., nCurrent ON ERROR IF .NOT. lOk DO TList WITH WM_PAINT, WM_DRAWITEM, nCurrent ON POPUP CS_FILE_1 DO TList WITH LBN_SELCHA, .F., nCurrent ENDIF ON SELECTION POPUP CS_FILE_1 DO TList WITH LBN_DBLCLK, .F., nCurrent *--------------------------------------------- *-- Keyboard to position bar at last selection *--------------------------------------------- IF .NOT. ISBLANK( CATALOG() ) n = nCS_FILE - 2 ELSE IF nCS_FILE = 3 n = 0 ELSE n = nCS_FILE - 3 ENDIF ENDIF IF n > 0 i = 1 DO WHILE i < n KEYBOARD [{DnArrow}] i = i + 1 ENDDO ENDIF ACTIVATE POPUP CS_FILE_1 ON KEY LABEL Tab ON KEY LABEL BackTab DO ClrOnKey ON MOUSE pl_IsPop = .F. IF BAR() > 0 IF nMess <> DLN_OK nMess = KB_ENTER ENDIF ON ERROR lOk = .F. RESTORE SCREEN FROM CS_FILE_1 RELEASE SCREEN CS_FILE_1 ON ERROR ELSE IF nMess = 0 IF nMsEvent = KB_MOUSE nMess = KB_MOUSE RESTORE SCREEN FROM CS_FILE_1 RELEASE SCREEN CS_FILE_1 ELSE nMess = LASTKEY() ENDIF ELSE ON ERROR lOk = .F. RESTORE SCREEN FROM CS_FILE_1 RELEASE SCREEN CS_FILE_1 ON ERROR ENDIF ENDIF CASE pn_msg = LBN_SELCHA *-- ON POPUP Handler here IF pnObject = 5 IF OpenFiVl( "CS_FILE_1" ) ENDIF ENDIF CASE pn_msg = LBN_DBLCLK SAVE SCREEN TO CS_FILE_1 STORE BAR() TO nCS_FILE IF pnObject = 5 IF OpenFiVl( "CS_FILE_1" ) ENDIF ENDIF DEACTIVATE POPUP ENDCASE CASE pnObject = 7 DO CASE CASE pn_msg = WM_PAINT DO CASE CASE p__data = LBN_KILLFO DO HasTitle WITH nCurrent, BN_UNHILITE CASE p__data = WM_DRAWITEM SET COLOR OF MESS TO n/gb SET COLOR OF TITLE TO n/gb *-------------------------------------------------- *-- Build the popup based on a comma delimited list *-------------------------------------------------- DEFINE POPUP Cl_type_1 FROM 4, 21 TO 10, 49 DEFINE BAR 1 OF CL_TYPE_1 PROMPT "Screen files (*.scr)" DEFINE BAR 2 OF CL_TYPE_1 PROMPT "Database files (*.dbf)" DEFINE BAR 3 OF CL_TYPE_1 PROMPT "Program files (*.prg)" DEFINE BAR 4 OF CL_TYPE_1 PROMPT "Compiled files(*.dbo)" DEFINE BAR 5 OF CL_TYPE_1 PROMPT "All Files (*.*)" SHOW POPUP CL_TYPE_1 ENDCASE CASE pn_msg = LBN_SETFOC SET COLOR OF MESS TO n/gb SET COLOR OF TITLE TO n/gb nMsEvent = 0 nMess = 0 nAccel = 0 && dBRIEF Tag... pl_IsPop = .T. ON MOUSE DO MsHand WITH MROW(), MCOL(), .T. DO SetOnKey ON KEY LABEL Tab DO TabOut WITH KB_TAB ON KEY LABEL BackTab DO TabOut WITH KB_SHIFTTAB lOk = .T. ON ERROR lOk = .F. ON POPUP CL_TYPE_1 DO TList WITH LBN_SELCHA, .F., nCurrent ON ERROR IF .NOT. lOk DO TList WITH WM_PAINT, WM_DRAWITEM, nCurrent ON POPUP CL_TYPE_1 DO TList WITH LBN_SELCHA, .F., nCurrent ENDIF ON SELECTION POPUP CL_TYPE_1 DO TList WITH LBN_DBLCLK, .F., nCurrent *--------------------------------------------- *-- Keyboard to position bar at last selection *--------------------------------------------- n = nCL_TYPE IF n > 0 i = 1 DO WHILE i < n KEYBOARD [{DnArrow}] i = i + 1 ENDDO ENDIF ACTIVATE POPUP CL_TYPE_1 ON KEY LABEL Tab ON KEY LABEL BackTab DO ClrOnKey ON MOUSE pl_IsPop = .F. IF BAR() > 0 IF nMess <> DLN_OK nMess = KB_ENTER ENDIF ON ERROR lOk = .F. RESTORE SCREEN FROM CL_TYPE_1 RELEASE SCREEN CL_TYPE_1 ON ERROR ELSE IF nMess = 0 IF nMsEvent = KB_MOUSE nMess = KB_MOUSE RESTORE SCREEN FROM CL_TYPE_1 RELEASE SCREEN CL_TYPE_1 ELSE nMess = LASTKEY() ENDIF ELSE ON ERROR lOk = .F. RESTORE SCREEN FROM CL_TYPE_1 RELEASE SCREEN CL_TYPE_1 ON ERROR ENDIF ENDIF CASE pn_msg = LBN_SELCHA *-- ON POPUP Handler here IF pnObject = 7 IF OpenFiVl( "CL_TYPE_1" ) ENDIF ENDIF CASE pn_msg = LBN_DBLCLK SAVE SCREEN TO CL_TYPE_1 STORE BAR() TO nCL_TYPE IF pnObject = 7 IF OpenFiVl( "CL_TYPE_1" ) ENDIF ENDIF DEACTIVATE POPUP ENDCASE ENDCASE RETURN *-- EOP: TList WITH pn_msg, p__data, pnObject PROCEDURE TabOut PARAMETERS pn_Key *---------------------------------------------------------------------------- * NAME * TabOut - * * DESCRIPTION * * PARAMETERS * pn_Key = * *---------------------------------------------------------------------------- PRIVATE nRow, nCol, cPath, cPrompt, cDrive nRow = ROW() nCol = COL() DO CASE CASE nCurrent = 5 STORE BAR() TO nCS_FILE *-- Redisplay the bar because of a "feature" in dBASE cPrompt = TRIM( PROMPT() ) cDrive = _FileDrv( cPrompt ) IF .NOT. ISBLANK( cDrive ) cPath = cDrive + ":" + _FilePath( cPrompt ) ELSE cPath = _FilePath( cPrompt ) ENDIF cPrompt = TRIM( SUBSTR( cPrompt, LEN( cPath )+1 ) ) cPrompt = LEFT( cPrompt + SPACE( 12 ), 12 ) @ nRow, nCol SAY cPrompt COLOR w+/g SAVE SCREEN TO CS_FILE_1 nMess = pn_Key KEYBOARD "{LeftArrow}" CASE nCurrent = 7 STORE BAR() TO nCL_TYPE *-- Redisplay the bar because of a "feature" in dBASE cPrompt = TRIM( PROMPT() ) cPrompt = LEFT( cPrompt + SPACE( 27 ), 27 ) @ nRow, nCol SAY cPrompt COLOR w+/g SAVE SCREEN TO CL_TYPE_1 nMess = pn_Key KEYBOARD "{LeftArrow}" ENDCASE RETURN *-- EOP: TabOut WITH pn_Key PROCEDURE TCombo PARAMETERS pn_msg, p__data, pnObject *---------------------------------------------------------------------------- * NAME * TCombo - * * DESCRIPTION * * PARAMETERS * pn_msg = * p__data = * pnObject = * *---------------------------------------------------------------------------- PRIVATE cDisplay DO CASE CASE pnObject = 5 DO CASE CASE pn_msg = WM_PAINT DO CASE CASE p__data = CBN_KILLFOC DO HasTitle WITH pnObject, BN_UNHILITE CASE p__data = CB_HIDELST @ 3, 2 GET CS_FILE_1 PICTURE 'XXXXXXXXXXXXXXX' CLEAR GETS CASE p__data = CB_SHOWDRO DO TList WITH WM_PAINT, WM_DRAWITEM, pnObject ENDCASE CASE pn_msg = CBN_DROPDOW SAVE SCREEN TO Tcombo DO TCombo WITH WM_PAINT, CB_SHOWDRO, pnObject DO TCombo WITH CBN_INLIST, .F., pnObject DO TCombo WITH WM_PAINT, CB_HIDELST, pnObject RESTORE SCREEN FROM Tcombo RELEASE SCREEN Tcombo @ 3, 2 GET CS_FILE_1 PICTURE 'XXXXXXXXXXXXXXX' CLEAR GETS CASE pn_msg = CB_SELECTS *----------------------------------------------------- *-- Do not repaint the get area during scroll re-entry *----------------------------------------------------- IF nCs_file > 0 IF BAR() <> nCs_file RETURN ELSE nCs_file = 0 ENDIF ENDIF IF TYPE( "p__data" ) = "L" cPrompt = PROMPT() ELSE cPrompt = p__data ENDIF cFileRoot = _FileRoot( cPrompt ) IF .NOT. "<" $ cFileRoot STORE cFileRoot + "." + _FileType( cPrompt ) TO cDisplay STORE LEFT( cPrompt + SPACE( 80 ), 80 ) TO CS_FILE_1 STORE LEFT( cDisplay + SPACE( 80 ), 80 ) TO cDisplay @ 3 , 2 GET cDisplay PICTURE 'XXXXXXXXXXXXXXX' CLEAR GETS ENDIF CASE pn_msg = CBN_INLIST SET COLOR OF MESS TO n/gb SET COLOR OF TITLE TO n/gb nMsEvent = 0 nMess = 0 nAccel = 0 pl_IsPop = .T. ON MOUSE DO MsHand WITH MROW(), MCOL(), .T. DO SetOnKey ON KEY LABEL Tab DO TabOut WITH KB_TAB ON KEY LABEL BackTab DO TabOut WITH KB_SHIFTTAB ON POPUP CS_FILE_1 DO TCombo WITH CB_SELECTS, .F., pnObject ON SELECTION POPUP CS_FILE_1 DO TComboSel *------------------------------------------------- *-- Keyboard in down arrows to match prompt string *------------------------------------------------- IF nCs_file > 0 n = 1 nHowMany = nCs_file - 1 IF ISBLANK( CATALOG() ) nHowMany = nHowMany - 3 ELSE nHowMany = nHowMany - 2 ENDIF DO WHILE n <= nHowMany KEYBOARD [{DnArrow}] n = n + 1 ENDDO ENDIF ACTIVATE POPUP CS_FILE_1 pl_IsPop = .F. ON KEY LABEL Tab ON KEY LABEL BackTab DO ClrOnKey ON MOUSE IF BAR() > 0 SHOW POPUP CS_FILE_1 nMess = KB_ENTER nCs_file = BAR() ELSE IF nMess = 0 IF nMsEvent = KB_MOUSE nMess = KB_MOUSE RESTORE SCREEN FROM CS_FILE_1 RELEASE SCREEN CS_FILE_1 ELSE nMess = LASTKEY() ENDIF ELSE RESTORE SCREEN FROM CS_FILE_1 RELEASE SCREEN CS_FILE_1 ENDIF ENDIF ENDCASE CASE pnObject = 7 DO CASE CASE pn_msg = WM_PAINT DO CASE CASE p__data = CBN_KILLFOC DO HasTitle WITH pnObject, BN_UNHILITE CASE p__data = CB_HIDELST @ 3, 20 GET CL_TYPE_1 PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXX' @ 3, 49 SAY CHR(222) COLOR g/w @ 3, 50 SAY CHR(25) COLOR n/g @ 3, 51 SAY CHR(221) COLOR g/w CLEAR GETS CASE p__data = CB_SHOWDRO DO TList WITH WM_PAINT, WM_DRAWITEM, pnObject ENDCASE CASE pn_msg = CBN_DROPDOW SAVE SCREEN TO Tcombo DO TCombo WITH WM_PAINT, CB_SHOWDRO, pnObject DO TCombo WITH CBN_INLIST, .F., pnObject DO TCombo WITH WM_PAINT, CB_HIDELST, pnObject RESTORE SCREEN FROM Tcombo RELEASE SCREEN Tcombo @ 3, 20 GET CL_TYPE_1 PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXX' CLEAR GETS CASE pn_msg = CB_SELECTS *----------------------------------------------------- *-- Do not repaint the get area during scroll re-entry *----------------------------------------------------- IF nCl_type > 0 IF BAR() <> nCl_type RETURN ELSE nCl_type = 0 ENDIF ENDIF IF TYPE( "p__data" ) = "L" cPrompt = PROMPT() ELSE cPrompt = p__data ENDIF STORE cPrompt TO CL_TYPE_1 STORE LEFT( CL_TYPE_1 + SPACE( 33 ), 33 ) TO CL_TYPE_1 @ 3 , 20 GET CL_TYPE_1 PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXX' CLEAR GETS CASE pn_msg = CBN_INLIST SET COLOR OF MESS TO n/gb SET COLOR OF TITLE TO n/gb nMsEvent = 0 nMess = 0 nAccel = 0 pl_IsPop = .T. ON MOUSE DO MsHand WITH MROW(), MCOL(), .T. DO SetOnKey ON KEY LABEL Tab DO TabOut WITH KB_TAB ON KEY LABEL BackTab DO TabOut WITH KB_SHIFTTAB ON POPUP CL_TYPE_1 DO TCombo WITH CB_SELECTS, .F., pnObject ON SELECTION POPUP CL_TYPE_1 DO TComboSel *------------------------------------------------- *-- Keyboard in down arrows to match prompt string *------------------------------------------------- IF nCl_type > 0 n = 1 nHowMany = nCl_type - 1 DO WHILE n <= nHowMany KEYBOARD [{DnArrow}] n = n + 1 ENDDO ENDIF ACTIVATE POPUP CL_TYPE_1 pl_IsPop = .F. ON KEY LABEL Tab ON KEY LABEL BackTab DO ClrOnKey ON MOUSE IF BAR() > 0 nMess = KB_ENTER nCl_type = BAR() ELSE IF nMess = 0 IF nMsEvent = KB_MOUSE nMess = KB_MOUSE RESTORE SCREEN FROM CL_TYPE_1 RELEASE SCREEN CL_TYPE_1 ELSE nMess = LASTKEY() ENDIF ELSE RESTORE SCREEN FROM CL_TYPE_1 RELEASE SCREEN CL_TYPE_1 ENDIF ENDIF ENDCASE ENDCASE RETURN *-- EOP: TCombo WITH pn_msg, p__data, pnObject PROCEDURE TComboSel *---------------------------------------------------------------------------- * NAME * TComboSel - * * DESCRIPTION * *---------------------------------------------------------------------------- DO TCombo WITH CB_SELECTS, .F., pnObject DEACTIVATE POPUP RETURN *-- EOP: TComboSel PROCEDURE GetDDL *---------------------------------------------------------------------------- * NAME * GetDDL - Get Combo Box Drop Down List * * DESCRIPTION * *---------------------------------------------------------------------------- lShowDrop = ( nAccel > 0 .OR. nMess = KB_MOUSE ) .AND. nMess <> KB_ENTER DO CASE CASE nCurrent = 7 && CL_TYPE_1 *------------------------------------------------- *-- Look to see if the object in focus has a title *------------------------------------------------- DO HasTitle WITH nCurrent, BN_HILITE @ 3, 20 GET CL_TYPE_1 PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXX' @ 3, 49 SAY CHR(222) COLOR g/w @ 3, 50 SAY CHR(25) COLOR n/g @ 3, 51 SAY CHR(221) COLOR g/w CLEAR GETS ENDCASE IF lShowDrop nMess = KB_SPACE ELSE SET CONSOLE OFF SET CURSOR OFF WAIT SET CONSOLE ON nMess = LASTKEY() nMRow = MROW() nMCol = MCOL() ENDIF RETURN *-- EOP: GetDDL PROCEDURE SetOnKey *---------------------------------------------------------------------------- * NAME * SetOnKey - For each pick key, set on key label * * DESCRIPTION * *---------------------------------------------------------------------------- ON KEY LABEL Alt-n DO AKeyHand WITH '5' ON KEY LABEL Alt-T DO AKeyHand WITH '7' ON KEY LABEL Alt-R DO AKeyHand WITH '15' ON KEY LABEL Alt-D DO AKeyHand WITH '19' RETURN *-- EOP: SetOnKey PROCEDURE ClrOnKey *---------------------------------------------------------------------------- * NAME * ClrOnKey - For each pick key, clear on label * * DESCRIPTION * *---------------------------------------------------------------------------- ON KEY LABEL Alt-n ON KEY LABEL Alt-T ON KEY LABEL Alt-R ON KEY LABEL Alt-D RETURN *-- EOP: ClrOnKey PROCEDURE AKeyHand PARAMETERS cId *---------------------------------------------------------------------------- * NAME * AKeyHand - On key handler for Accel key from popup or get * * DESCRIPTION * * PARAMETERS * nId = * *---------------------------------------------------------------------------- IF nAccel <> nCurrent nAccel = VAL( cId ) IF TYPE( "pl_IsPop" ) = "L" .AND. pl_IsPop DO CASE CASE nCurrent = 5 STORE BAR() TO nCS_FILE SAVE SCREEN TO CS_FILE_1 KEYBOARD "{LeftArrow}" nMess = KB_ENTER CASE nCurrent = 7 STORE BAR() TO nCL_TYPE SAVE SCREEN TO CL_TYPE_1 KEYBOARD "{LeftArrow}" nMess = KB_ENTER OTHERWISE KEYBOARD "{Ctrl-W}" nMess = KB_CTRLW ENDCASE ELSE KEYBOARD "{Ctrl-W}" nMess = KB_CTRLW ENDIF ELSE nAccel = 0 ENDIF RETURN *-- EOP: AKeyHand WITH nId PROCEDURE CkWaitAc *---------------------------------------------------------------------------- * NAME * CkWaitAc - Look for Accel key from Wait command * * DESCRIPTION * This routine has high International risk for translations. *---------------------------------------------------------------------------- IF nMess < 0 nAccPress = nMess + 500 ELSE IF nMess >= 97 .AND. nMess <= 122 nMess = nMess - 32 ENDIF nAccPress = nMess ENDIF DO CASE CASE nAccPress = 78 && n - CS_FILE_0 nAccel = 5 CASE nAccPress = 84 && T - CL_TYPE_0 nAccel = 7 CASE nAccPress = 82 && R - CK_READ_1 nAccel = 15 CASE nAccPress = 68 && D - BT_DEMO nAccel = 19 OTHERWISE nAccel = 0 ENDCASE RETURN *-- EOP: CkWaitAc FUNCTION GetMsTo PARAMETER plChkOnly *---------------------------------------------------------------------------- * NAME * GetMsTo() - * * DESCRIPTION * *---------------------------------------------------------------------------- *-- Check for a click on the close button IF nMRow = nRowCls .AND. nMCol >= nLColCls .AND. nMCol <= nRColCls nMess = DLN_CANCEL nRtn = 0 ELSE IF nMRow = nRowCls .AND. nMCol >= nCol .AND. nMCol <= nRWinCol *--------------------------------------------------------- *-- All this to remove the shadow before moving the window *--------------------------------------------------------- SAVE WINDOW OPENFILE TO _OPENFILE RELEASE WINDOW OPENFILE RESTORE SCREEN FROM OPENFILE RESTORE WINDOW OPENFILE FROM _OPENFILE ERASE _OPENFILE.win ACTIVATE WINDOW OPENFILE @ 0, 0 TO nHigh - 1, nWidth - 1 COLOR g+/w @ 0, 2 SAY "[ ]" COLOR g+/w @ 0, 3 SAY CHR( 254 ) COLOR g+/w @ 0, 22 SAY " Open file" COLOR g+/w *------------------------------- *-- Start the move window action *------------------------------- nDelX = nMRow nDelY = nMCol SET CONSOLE OFF WAIT SET CONSOLE ON nMRow = MROW() nMCol = MCOL() nDelX = nMRow - nDelX nDelY = nMCol - nDelY lMoveOk = .T. ON ERROR lMoveOk = .F. MOVE WINDOW OPENFILE BY nDelX, nDelY ON ERROR IF lMoveOk nRowCls = nRowCls + nDelX nCol = nCol + nDelY nLColCls = ncol + 2 && Left column for close button nRColCls = ncol + 4 && End column for close button nRWinCol = ncol + nWidth - 1 && Rigth column for window nXOffset = nRowCls - nOrigRow nYOffset = nCol - nOrigCol ENDIF *--------------------------------------------------------- *-- Display the new shadow for after moving the dialog box *--------------------------------------------------------- SAVE WINDOW OPENFILE TO _OPENFILE RELEASE WINDOW OPENFILE RESTORE SCREEN FROM OPENFILE ACTIVATE SCREEN IF nCol + 60 < 80 .AND. nRowCls + 18 <= nScreen @ nRowCls + 1, nCol + 1 FILL TO nRowCls + 18, nCol + 60 COLOR n+/n ENDIF RESTORE WINDOW OPENFILE FROM _OPENFILE ERASE _OPENFILE.win ACTIVATE WINDOW OPENFILE @ 0, 0 TO nHigh - 1, nWidth - 1 DOUBLE COLOR w+/w @ 0, 2 SAY "[ ]" COLOR w+/w @ 0, 3 SAY CHR( 254 ) COLOR g+/w @ 0, 22 SAY " Open file" COLOR w+/w nRtn = -1 ELSE *----------------------------------- *-- Check for click on a live object *----------------------------------- nRtn = 0 i = 1 DO WHILE i <= nClkObj IF nMRow = aClkObj[ i, 1 ] + nXOffSet .AND. ; nMCol >= aClkObj[ i, 2 ] + nYOffset .AND. ; nMCol <= aClkObj[ i, 3 ] + nYOffset nRtn = aClkObj[ i, 4 ] EXIT ENDIF i = i + 1 ENDDO IF nRtn = 0 *---------------------------------------------------------- *-- Not found, check for a click in a Combo box or list box *---------------------------------------------------------- IF nClkBox > 0 i = 1 DO WHILE i <= nClkBox IF nMRow >= aClkBox[ i, 1 ] + nXOffset .AND. ; nMRow <= aClkBox[ i, 1 ] + nXOffset + aClkBox[ i, 2 ] .AND. ; nMCol >= aClkBox[ i, 3 ] + nYOffset .AND. ; nMCol <= aClkBox[ i, 3 ] + nYOffset + aClkBox[ i, 4 ] nRtn = aClkBox[ i, 5 ] - 1 aClkBox[ i, 6 ] = .T. EXIT ENDIF i = i + 1 ENDDO ENDIF ENDIF ENDIF ENDIF RETURN( nRtn ) *-- EOF: GetMsTo( ) PROCEDURE MsHand PARAMETERS pnMRow, pnMCol, pl_IsPop *---------------------------------------------------------------------------- * NAME * MsHand - * * DESCRIPTION * * PARAMETERS * pnMRow = * pnMCol = * pl_IsPop = * *---------------------------------------------------------------------------- nMRow = pnMRow nMCol = pnMCol nMsEvent = KB_MOUSE IF pl_IsPop DO CASE CASE nCurrent = 5 STORE BAR() TO nCS_FILE SAVE SCREEN TO CS_FILE_1 KEYBOARD "{LeftArrow}" CASE nCurrent = 7 STORE BAR() TO nCL_TYPE SAVE SCREEN TO CL_TYPE_1 KEYBOARD "{LeftArrow}" ENDCASE ELSE KEYBOARD "{Ctrl-W}" ENDIF RETURN *-- EOP: MsHand WITH pnMRow, pnMCol, pl_IsPop PROCEDURE Dispatch *---------------------------------------------------------------------------- * NAME * Dispatch - * * DESCRIPTION * *---------------------------------------------------------------------------- DO CASE CASE nCurrent = 5 && CS_FILE_1 DO DispCS CASE nCurrent = 7 && CL_TYPE_1 DO DispCL CASE nCurrent = 15 && CK_READ_1 DO DispCk CASE nCurrent = 19 && BT_DEMO DO DispBt CASE nCurrent = 20 && BT_OK DO DispBt CASE nCurrent = 21 && BT_CANCEL DO DispBt ENDCASE RETURN *-- EOP: Dispatch PROCEDURE DispCk *---------------------------------------------------------------------------- * NAME * DispCk - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE nPossNext DO CASE CASE nMess = KB_TAB DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .T. CASE nMess = KB_SHIFTTAB DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .F. CASE nMess = KB_UPARROW .OR. nMess = KB_LEFTARROW DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .F., .T. CASE nMess = KB_DOWNARROW .OR. nMess = KB_RTARROW DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .T., .T. CASE nMess = KB_SPACE DO TButton WITH BN_CLICKED, .F., nCurrent CASE nMess = KB_MOUSE nPossNext = GetMsTo() IF nPossNext > 0 IF nPossNext = nCurrent DO TButton WITH BN_CLICKED, .F., nCurrent ELSE DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH nPossNext, .F. ENDIF ENDIF CASE nMess = KB_ENTER IF nDlgDef > 0 DO TButton WITH BN_CLICKED, .F., nDlgDef ENDIF OTHERWISE DO CkWaitAc IF nAccel > 0 IF nAccel = nCurrent DO TButton WITH BN_CLICKED, .F., nCurrent ELSE DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH nAccel, .F. ENDIF ENDIF ENDCASE RETURN *-- EOP: DispCk PROCEDURE DispBt *---------------------------------------------------------------------------- * NAME * DispBt - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE nPossNext DO CASE CASE nMess = KB_TAB DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .T. CASE nMess = KB_SHIFTTAB DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH .F. CASE nMess = KB_ENTER DO TButton WITH BN_CLICKED, .F., nCurrent CASE nMess = KB_MOUSE nPossNext = GetMsTo() IF nPossNext > 0 IF nPossNext = nCurrent DO TButton WITH BN_CLICKED, .F., nCurrent ELSE DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH nPossNext, .F. ENDIF ENDIF OTHERWISE DO CkWaitAc IF nAccel > 0 IF nAccel = nCurrent DO TButton WITH BN_CLICKED, .F., nCurrent ELSE DO TButton WITH WM_PAINT, BN_UNHILITE, nCurrent DO GetNext WITH nAccel, .F. ENDIF ENDIF ENDCASE RETURN *-- EOP: DispBt PROCEDURE DispCS *---------------------------------------------------------------------------- * NAME * DispCS - * * DESCRIPTION * *---------------------------------------------------------------------------- DO CASE CASE nMess = KB_TAB DO GetNext WITH .T. CASE nMess = KB_SHIFTTAB DO GetNext WITH .F. CASE nMess = KB_ENTER IF nDlgDef > 0 DO GetNext WITH nDlgDef IF nCurrent = nDlgDef DO TButton WITH BN_CLICKED, .F., nDlgDef ENDIF ENDIF CASE nMess = KB_DOWNARROW .OR. ; nMess = KB_UPARROW *----------------------------------------------- *-- GENCODE - Do VALID code here from Memo field *----------------------------------------------- DO CASE CASE nCurrent = 5 && CS_FILE_1 IF OpenFiVl( "CS_FILE_1" ) ENDIF ENDCASE DO TCombo WITH CBN_INLIST, .F., nCurrent IF nMsEvent = KB_MOUSE nPossNext = GetMsTo() ELSE IF nAccel > 0 DO GetNext WITH nAccel RETURN ELSE nPossNext = 0 DO CASE CASE nCurrent = 5 aClkBox[ 1 ,6 ] = .F. ENDCASE ENDIF ENDIF nLastKey = LASTKEY() IF nLastKey = KB_ENTER IF nDlgDef > 0 DO GetNext WITH nDlgDef IF nCurrent = nDlgDef DO TButton WITH BN_CLICKED, .F., nDlgDef ENDIF ENDIF ENDIF IF nPossNext > 0 IF nPossNext <> nCurrent *-- User clicked to another field DO GetNext WITH nPossNext ELSE nMess = 0 ENDIF ELSE DO CASE CASE nMess = KB_TAB DO GetNext WITH .T. CASE nMess = KB_SHIFTTAB DO GetNext WITH .F. ENDCASE ENDIF CASE nMess = KB_MOUSE nPossNext = GetMsTo() IF nPossNext > 0 IF nPossNext <> nCurrent *-- User clicked to another field DO GetNext WITH nPossNext ELSE *-- User clicked inside of list box DO TCombo WITH CBN_INLIST, .F., nCurrent DO CASE CASE nCurrent = 5 aClkBox[ 1 ,6 ] = .F. ENDCASE IF nMsEvent = KB_MOUSE nPossNext = GetMsTo() ELSE IF nAccel > 0 DO GetNext WITH nAccel RETURN ELSE nPossNext = 0 ENDIF ENDIF nLastKey = LASTKEY() IF nLastKey = KB_ENTER IF nDlgDef > 0 DO TButton WITH BN_CLICKED, .F., nDlgDef RETURN ENDIF ENDIF IF nPossNext > 0 IF nPossNext <> nCurrent *-- User clicked to another field DO GetNext WITH nPossNext ELSE nMess = 0 ENDIF ELSE DO CASE CASE nMess = KB_TAB DO GetNext WITH .T. CASE nMess = KB_SHIFTTAB DO GetNext WITH .F. ENDCASE ENDIF ENDIF ENDIF CASE nMess = KB_CTRLW .AND. nAccel > 0 DO GetNext WITH nAccel OTHERWISE DO CkWaitAc IF nAccel > 0 IF nAccel <> nCurrent DO GetNext WITH nAccel ENDIF ENDIF ENDCASE RETURN *-- EOP: DispCS PROCEDURE DispCL *---------------------------------------------------------------------------- * NAME * DispCL - * * DESCRIPTION * *---------------------------------------------------------------------------- PRIVATE nPossNext, lOkSelect DO CASE CASE nMess = KB_TAB DO GetNext WITH .T. CASE nMess = KB_SHIFTTAB DO GetNext WITH .F. CASE nMess = KB_MOUSE nPossNext = GetMsTo() IF nPossNext > 0 IF nPossNext = nCurrent nMess = KB_MOUSE ELSE DO GetNext WITH nPossNext, .F. ENDIF ELSE IF nMess <> DLN_CANCEL nMess = 0 ENDIF ENDIF CASE nMess = KB_CTRLW .AND. nAccel > 0 DO GetNext WITH nAccel, .F. CASE nMess = KB_ENTER IF nDlgDef > 0 DO TButton WITH BN_CLICKED, .F., nDlgDef ENDIF CASE nMess = KB_DOWNARROW .OR. ; nMess = KB_SPACE .OR. ; nMess = KB_UPARROW DO TCombo WITH CBN_DROPDOW, .F., nCurrent *------------------------------- *-- GENCODE - Do VALID code here *------------------------------- lOkSelect = .T. DO CASE CASE nCurrent = 7 && CL_TYPE_1 lOkSelect = OpenFiVl( "CL_TYPE_1" ) ENDCASE IF .NOT. lOkSelect STORE 0 TO nMess, nMsEvent ENDIF IF nMsEvent = KB_MOUSE nPossNext = GetMsTo() IF nPossNext > 0 IF nPossNext <> nCurrent *-- User clicked to another field DO GetNext WITH nPossNext, .F. ENDIF ENDIF ELSE DO CASE CASE nMess = KB_TAB DO GetNext WITH .T. CASE nMess = KB_SHIFTTAB DO GetNext WITH .F. CASE nAccel > 0 DO GetNext WITH nAccel, .F. ENDCASE ENDIF OTHERWISE DO CkWaitAc IF nAccel > 0 IF nAccel <> nCurrent DO GetNext WITH nAccel, .F. ENDIF ENDIF ENDCASE RETURN *-- EOP: DispCl PROCEDURE GetNext PARAMETERS p__dir, pl_SameGrp *---------------------------------------------------------------------------- * NAME * GetNext - * * DESCRIPTION * * PARAMETERS * p__dir = .T. to go forward, .F. to go back, number to go to * record number. * pl_SameGrp = .F. to go to first item in next/prev group, .T. will * go to the next/prev item within the same group. Only * applies to p__dir being next/previous. * *---------------------------------------------------------------------------- PRIVATE cPrevClass, nWay, npCurrent, nPointer, nNextObj, nNextPtr PRIVATE nRecNo, npRecNo, lExit, cField, cVar, cCurrClass *-------------------------------------------------------------- *-- Check for OK conditions, unless its a direct move to cancel *-------------------------------------------------------------- IF ( TYPE( 'p__dir' ) = "N" .AND. p__dir <> nCancelBt ) .OR. ; TYPE( 'p__dir' ) = "L" DO CASE CASE nCurrent = 5 && CS_FILE_1 IF .NOT. OpenFiVl( "CS_FILE_1" ) RETURN ENDIF CASE nCurrent = 7 && CL_TYPE_1 IF .NOT. OpenFiVl( "CL_TYPE_1" ) RETURN ENDIF ENDCASE ENDIF *------------------------------------------ *-- Check for move out of the current group *------------------------------------------ IF .NOT. pl_SameGrp IF TYPE( "p__dir" ) = "L" DO HasTitle WITH nCurrent, BN_UNHILITE ENDIF ENDIF cPrevClass = LEFT( aClkObj[ aObjPoint[ nCurrent ], 11 ], 3 ) *-------------------------------------------------- *-- Set the current CK or RB pointer before leaving *-------------------------------------------------- DO CASE CASE nCurrent = 15 && CK_READ_1 STORE nCurrent TO nCK_READ ENDCASE *---------------------------------------- *-- Handle the forward and backward moves *---------------------------------------- IF TYPE( "p__dir" ) = "L" DO CASE *------------------------------------------- *-- Go forward or backward in the same group *------------------------------------------- CASE pl_SameGrp nWay = IIF( p__dir, 10, 9 ) && 10 Forward, 9 Back npCurrent = aObjPoint[ nCurrent ] nPointer = npCurrent *----------------------------------------------- *-- Is this a one item radio button or check box *----------------------------------------------- IF aClkObj[ npCurrent, 4 ] <> aClkObj[ npCurrent, nWay ] DO WHILE .T. *------------------------------------------------------ *-- Check to see if the next object's WHEN clause is Ok *------------------------------------------------------ nNextObj = aClkObj[ nPointer, nWay ] IF WhenOk( nNextObj ) nPointer = aObjPoint[ nNextObj ] EXIT ELSE *----------------------------------------------- *-- See if we looped back to the item we were on *----------------------------------------------- nNextPtr = aObjPoint[ nNextObj ] IF nNextPtr = npCurrent EXIT ELSE nPointer = nNextPtr ENDIF ENDIF ENDDO ENDIF IF nPointer <> npCurrent nCurrent = aClkObj[ nPointer, 4 ] nCurrGrp = aClkObj[ nPointer, 5 ] ENDIF OTHERWISE nWay = IIF( p__dir, 6, 7 ) && 6 Forward, 7 Back nRecNo = nCurrent npRecNo = aObjPoint[ nRecNo ] lExit = .F. DO WHILE aClkObj[ npRecNo, 5 ] = nCurrGrp nRecNo = aClkObj[ npRecNo, nWay ] npRecNo = aObjPoint[ nRecNo ] IF aClkObj[ npRecNo, 5 ] = nCurrGrp LOOP ELSE *-------------------------------------------------- *-- Finally, we have moved out of the current group *-------------------------------------------------- nCurrGrp = aClkObj[ npRecNo, 5 ] IF .NOT. WhenOk( nRecNo ) LOOP ELSE nCurrent = nRecNo lExit = .T. ENDIF ENDIF *--------------------------------------------------------- *-- Was this a move into a radio button or check box group *--------------------------------------------------------- cField = aClkObj[ npRecNo, 11 ] cVar = "N" + LEFT( cField, RAT( "_", cField ) - 1 ) DO CASE CASE cVar = "NCK_READ" nRecNo = NCK_READ npRecNo = aObjPoint[ nRecNo ] nCurrent = nRecNo nCurrGrp = aClkObj[ npRecNo, 5 ] ENDCASE IF lExit EXIT ENDIF ENDDO DO HasTitle WITH nCurrent, BN_HILITE ENDCASE ELSE *------------------------------------------------------- *-- Handle direct moves to objects via Alt key and Mouse *------------------------------------------------------- IF .NOT. WhenOk( p__dir ) nMess = 0 RETURN ENDIF IF nCurrGrp <> aClkObj[ aObjPoint[ p__dir ], 5 ] DO HasTitle WITH nCurrent, BN_UNHILITE DO HasTitle WITH p__dir, BN_HILITE nCurrent = p__dir nCurrGrp = aClkObj[ aObjPoint[ nCurrent ], 5 ] DO CASE CASE nCurrent = 19 DO TButton WITH BN_CLICKED, .F., nCurrent CASE nCurrent = 20 DO TButton WITH BN_CLICKED, .F., nCurrent CASE nCurrent = 21 DO TButton WITH BN_CLICKED, .F., nCurrent ENDCASE ELSE DO HasTitle WITH p__dir, BN_HILITE ENDIF nCurrent = p__dir nCurrGrp = aClkObj[ aObjPoint[ nCurrent ], 5 ] ENDIF *--------------------------------------------------------------- *-- Repaint the Default button if we were on a button before and *-- the target is not a button. *--------------------------------------------------------------- cCurrClass = LEFT( aClkObj[ aObjPoint[ nCurrent ], 11 ], 3 ) IF cPrevClass = "BT_" .AND. cCurrClass <> "BT_" DO TButton WITH WM_PAINT, BN_DEFAULT, nDlgDef STORE .T. TO BT_OK ENDIF *--------------------------------------------------------- *-- Save the current CK or RB pointer for the target group *--------------------------------------------------------- DO CASE CASE nCurrent = 15 && CK_READ_1 STORE nCurrent TO nCK_READ IF TYPE( "p__dir" ) = "N" DO TButton WITH BN_CLICKED, .F., nCurrent ENDIF CASE nCurrent = 19 && BT_DEMO STORE nCurrent TO nBT IF TYPE( "p__dir" ) = "N" STORE .T. TO BT_DEMO ENDIF CASE nCurrent = 20 && BT_OK STORE nCurrent TO nBT IF TYPE( "p__dir" ) = "N" STORE .T. TO BT_OK ENDIF CASE nCurrent = 21 && BT_CANCEL STORE nCurrent TO nBT IF TYPE( "p__dir" ) = "N" STORE .T. TO BT_CANCEL ENDIF ENDCASE RETURN *-- EOP: GetNext WITH p__dir, pl_SameGrp FUNCTION WhenOk PARAMETERS pnTarget *---------------------------------------------------------------------------- * NAME * WhenOk - Validate the WHEN condition for a target object * * DESCRIPTION * * PARAMETERS * pnTarget = Object ID to verify against * *---------------------------------------------------------------------------- PRIVATE lWhenOk lWhenOk = .T. DO CASE CASE pnTarget = 7 && CL_TYPE_1 IF .NOT. ( OpenFiWn( "CL_TYPE_1" ) ) lWhenOk = .F. ENDIF ENDCASE RETURN lWhenOk *-- EOF: WhenOk( pnTarget ) FUNCTION GetId PARAMETERS pcVar *---------------------------------------------------------------------------- * NAME * GetId() - Search for memvar name and return current_id *---------------------------------------------------------------------------- PRIVATE nId nId = 0 DO CASE CASE pcVar = "CS_FILE_0" nId = 3 CASE pcVar = "CL_TYPE_0" nId = 4 CASE pcVar = "CS_FILE_1" nId = 5 CASE pcVar = "CL_TYPE_1" nId = 7 CASE pcVar = "CK_READ_0" nId = 12 CASE pcVar = "CK_READ_1" nId = 15 CASE pcVar = "BT_DEMO" nId = 19 CASE pcVar = "BT_OK" nId = 20 CASE pcVar = "BT_CANCEL" nId = 21 ENDCASE RETURN( nId ) *-- EOF: GetId( pcVar) PROCEDURE PostVals *---------------------------------------------------------------------------- * NAME * PostVals - * * DESCRIPTION * *---------------------------------------------------------------------------- IF TYPE( "OPENFILE[1]" ) <> "U" OPENFILE[ 1 ] = CS_FILE_1 OPENFILE[ 2 ] = CL_TYPE_1 OPENFILE[ 3 ] = CK_READ_1 OPENFILE[ 4 ] = BT_DEMO OPENFILE[ 5 ] = BT_OK OPENFILE[ 6 ] = BT_CANCEL ENDIF RETURN *-- EOP: PostVals PROCEDURE ReleObjs *---------------------------------------------------------------------------- * NAME * ReleObjs - Scan the design DBF file and release the object variables * * DESCRIPTION * *---------------------------------------------------------------------------- RELEASE POPUP CS_FILE_1 RELEASE POPUP CL_TYPE_1 RETURN *-- EOP: ReleObjs PROCEDURE IOPENFILE *---------------------------------------------------------------------------- * NAME * IOPENFILE - Builds the Initialization array for this dialog box * * DESCRIPTION * IOPENFILE with create a routine that you can call or cut from this * file to run a dialog box and capture the data on exit. * * To run the dialog box, * SET PROCEDURE TO OPENFILE * DO IOPENFILE * * Running IOPENFILE with use the defaults from the SCR file. The * array will remain in memory after execution. * * REMEMBER, REGENERATING THE DIALOG BOX WILL OVERWRITE THIS PROCEDURE! * *---------------------------------------------------------------------------- PUBLIC ARRAY OPENFILE[ 6 ] *-- CS_FILE_1 - XXXXXXXXXXXXXXX OPENFILE[ 1 ] = "*.SCR" + SPACE( 75 ) *-- CL_TYPE_1 - XXXXXXXXXXXXXXXXXXXXXXXXXXXXX [v] OPENFILE[ 2 ] = [SCREEN FILES (*.SCR)] + SPACE( 13 ) *-- CK_READ_1 - [ ] ~Read-only OPENFILE[ 3 ] = .F. *-- BT_DEMO - ~Demo dialog OPENFILE[ 4 ] = .F. *-- BT_OK - Ok OPENFILE[ 5 ] = .T. *-- BT_CANCEL - Cancel OPENFILE[ 6 ] = .F. *-------------------------------------------------------------- *-- FXL_Cancel is set to .T. is the user Cancels the dialog box *-------------------------------------------------------------- FXL_Cancel = .F. *-------------------------------------------------------------- *-- FXL_NoChng lets the dialog box know that the values in the *-- array are not different from the SCR file defaults. This *-- will allow the dialog box to use the .WIN file for a faster *-- startup. *-------------------------------------------------------------- FXL_NoChng = .T. DO OPENFILE IF .NOT. FXL_Cancel && The user clicked on OK *----------------------------------- *-- Put your Ok processing code here *----------------------------------- ENDIF RELEASE OPENFILE RETURN *-- EOP: IOPENFILE